home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / forth / pfe-0.000 / pfe-0 / pfe-0.9.13 / src / string.c < prev    next >
Encoding:
C/C++ Source or Header  |  1995-07-17  |  3.0 KB  |  149 lines
  1. /*
  2.  * This file is part of the portable Forth environment written in ANSI C.
  3.  * Copyright (C) 1995  Dirk Uwe Zoller
  4.  *
  5.  * This library is free software; you can redistribute it and/or
  6.  * modify it under the terms of the GNU Library General Public
  7.  * License as published by the Free Software Foundation; either
  8.  * version 2 of the License, or (at your option) any later version.
  9.  *
  10.  * This library is distributed in the hope that it will be useful,
  11.  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  12.  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13.  * See the GNU Library General Public License for more details.
  14.  *
  15.  * You should have received a copy of the GNU Library General Public
  16.  * License along with this library; if not, write to the Free
  17.  * Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  18.  *
  19.  * This file is version 0.9.13 of 17-July-95
  20.  * Check for the latest version of this package via anonymous ftp at
  21.  *    roxi.rz.fht-mannheim.de:/pub/languages/forth/pfe-VERSION.tar.gz
  22.  * or    sunsite.unc.edu:/pub/languages/forth/pfe-VERSION.tar.gz
  23.  * or    ftp.cygnus.com:/pub/forth/pfe-VERSION.tar.gz
  24.  *
  25.  * Please direct any comments via internet to
  26.  *    duz@roxi.rz.fht-mannheim.de.
  27.  * Thank You.
  28.  */
  29. /*
  30.  * string.c ---        The Optional String Word Set
  31.  * (duz 08Jul93)
  32.  */
  33.  
  34. #include "forth.h"
  35. #include "support.h"
  36. #include "compiler.h"
  37.  
  38. #include <string.h>
  39. #include <ctype.h>
  40.  
  41. #include "missing.h"
  42.  
  43.  
  44. Code (dash_trailing)
  45. {
  46.   sp[0] = dash_trailing ((char *)sp[1], sp[0]);
  47. }
  48.  
  49. Code (slash_string)
  50. {
  51.   uCell a = *sp++;
  52.   if (a < sp[0])
  53.     {
  54.       sp[0] -= a;
  55.       sp[1] += a;
  56.     }
  57.   else
  58.     {
  59.       sp[1] += sp[0];
  60.       sp[0] = 0;
  61.     }
  62. }
  63.  
  64. Code (blank)
  65. {
  66.   memset ((char *)sp[1], ' ', (uCell)sp[0]);
  67.   sp += 2;
  68. }
  69.  
  70. Code (cmove)
  71. {
  72.   char *p = (char *)sp[2];
  73.   char *q = (char *)sp[1];
  74.   uCell n = sp[0];
  75.   sp += 3;
  76.   while (n--)
  77.     *q++ = *p++;
  78. }
  79.  
  80. Code (cmove_up)
  81. {
  82.   char *p = (char *)sp[2];
  83.   char *q = (char *)sp[1];
  84.   uCell n = sp[0];
  85.   sp += 3;
  86.   p += n;
  87.   q += n;
  88.   while (n--)
  89.     *--q = *--p;
  90. }
  91.  
  92. Code (compare)
  93. {
  94.   char *p1 = (char *)sp[3];
  95.   uCell u1 = sp[2];
  96.   char *p2 = (char *)sp[1];
  97.   uCell u2 = sp[0];
  98.   int d;
  99.  
  100.   sp += 3;
  101.   if (u1 < u2)
  102.     *sp = (d = memcmp (p1, p2, u1)) == 0
  103.       ? -1
  104.       : d < 0 ? -1 : 1;
  105.   else
  106.     *sp = (d = memcmp (p1, p2, u2)) == 0
  107.       ? u1 == u2 ? 0 : 1
  108.       : d < 0 ? -1 : 1;
  109. }
  110.  
  111. Code (search)
  112. {
  113.   const char *p =
  114.     search ((char *)sp[3], sp[2], (char *)sp[1], sp[0]);
  115.   ++sp;
  116.   if (p == NULL)
  117.     sp[0] = FALSE;
  118.   else
  119.     {
  120.       sp[0] = TRUE;
  121.       sp[1] += (char *)sp[2] - p;
  122.       sp[2] = (Cell)p;
  123.     }
  124. }
  125.  
  126. Code (sliteral)
  127. {
  128.   compile1 ();
  129.   alloc_string ((char *)sp[1], sp[0]);
  130.   sp += 2;
  131. }
  132. code (s_quote_execution);
  133. COMPILES (sliteral, s_quote_execution,
  134.       SKIPS_STRING, DEFAULT_STYLE);
  135.  
  136.  
  137. LISTWORDS (string) =
  138. {
  139.   CO ("-TRAILING",    dash_trailing),
  140.   CO ("/STRING",    slash_string),
  141.   CO ("BLANK",        blank),
  142.   CO ("CMOVE",        cmove),
  143.   CO ("CMOVE>",        cmove_up),
  144.   CO ("COMPARE",    compare),
  145.   CO ("SEARCH",        search),
  146.   CS ("SLITERAL",    sliteral)
  147. };
  148. COUNTWORDS (string, "String + extensions");
  149.